home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / examples / xlib / picture < prev    next >
Encoding:
Text File  |  1991-08-05  |  2.4 KB  |  73 lines

  1. ;;; -*-Scheme-*-
  2.  
  3. ;;; -*- Mode:Lisp; Package:XLIB; Syntax:COMMON-LISP; Base:10; Lowercase:T -*-
  4.  
  5. ;;; CLX - Point Graphing demo program
  6.  
  7. ;;; Copyright (C) 1988 Michael O. Newton (newton@csvax.caltech.edu)
  8.  
  9. ;;; Permission is granted to any individual or institution to use, copy,
  10. ;;; modify, and distribute this software, provided that this complete
  11. ;;; copyright and permission notice is maintained, intact, in all copies and
  12. ;;; supporting documentation.
  13.  
  14. ;;; The author provides this software "as is" without express or
  15. ;;; implied warranty.
  16.  
  17. ;;; This routine plots the recurrance
  18. ;;;      x <- y(1+sin(0.7x)) - 1.2(|x|)^.5
  19. ;;;      y <- .21 - x
  20. ;;; As described in a ?? 1983 issue of the Mathematical Intelligencer
  21. ;;; It has ONLY been tested under X.V11R2 on a Sun3 running KCL
  22.  
  23. (require 'xlib)
  24.  
  25. (define (picture point-count)
  26.   (let* ((dpy (open-display))
  27.      (width 600)
  28.      (height 600)
  29.      (black (black-pixel dpy))
  30.      (white (white-pixel dpy))
  31.      (root (display-root-window dpy))
  32.      (win (create-window 'parent root 'background-pixel white
  33.                'event-mask '(exposure button-press)
  34.                'width width 'height height))
  35.      (gc (create-gcontext 'window win
  36.                 'background white 'foreground black)))
  37.     (map-window win)
  38.     (unwind-protect
  39.      (handle-events dpy #t #f
  40.        (expose
  41.     (lambda ignore
  42.       (clear-window win)
  43.       (draw-points win gc point-count 0.0 0.0 (* width 0.5) (* height 0.5))
  44.       (draw-poly-text win gc 10 10 (translate "Click a button to exit")
  45.               '1-byte)
  46.       #f))
  47.        (else (lambda ignore #t)))
  48.      (close-display dpy))))
  49.  
  50. ;;; Draw points.  These should maybe be put into a an array so that they do
  51. ;;; not have to be recomputed on exposure.  X assumes points are in the range
  52. ;;; of width x height, with 0,0 being upper left and 0,H being lower left.
  53. ;;;      x <- y(1+sin(0.7x)) - 1.2(|x|)^.5
  54. ;;;      y <- .21 - x
  55. ;;; hw and hh are half-width and half-height of screen
  56.  
  57. (define (draw-points win gc count x y hw hh)
  58.   (if (zero? (modulo count 100))
  59.       (display-flush-output (window-display win)))
  60.   (if (not (zero? count))
  61.       (let ((xf (floor (* (+ 1.2 x) hw ))) ; These lines center the picture
  62.         (yf (floor (* (+ 0.5 y) hh ))))
  63.     (draw-point win gc xf yf)
  64.     (draw-points win gc (1- count)
  65.              (- (* y (1+ (sin (* 0.7 x)))) (* 1.2 (sqrt (abs x))))
  66.              (- 0.21 x)
  67.              hw hh))))
  68.  
  69. (define (translate string)
  70.   (list->vector (map char->integer (string->list string))))
  71.  
  72. (picture 10000)
  73.